home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue26 / clinic / DBPICKER.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1997-09-19  |  4.2 KB  |  166 lines
  1. unit DBPicker;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ComCtrls, DB, DBCtrls;
  8.  
  9. type
  10.   TDBDateTimePicker = class(TDateTimePicker)
  11.   private
  12.     FDataLink: TFieldDataLink;
  13.   protected
  14.     procedure SetDataSource(Value: TDataSource);
  15.     function GetDataSource: TDataSource;
  16.     procedure SetDataField(const Value: String);
  17.     function GetDataField: String;
  18.     function GetField: TField;
  19.     procedure SetReadOnly(Value: Boolean);
  20.     function GetReadOnly: Boolean;
  21.     procedure DataChange(Sender: TObject);
  22.     procedure UpdateData(Sender: TObject);
  23.     procedure Notification(AComponent: TComponent;
  24.                            Operation: TOperation); override;
  25.     procedure CMEnter(var Msg: TCMEnter); message cm_Enter;
  26.     procedure CMExit(var Msg: TCMExit); message cm_Exit;
  27.     procedure CNNotify(var Msg: TWMNotify); message cn_Notify;
  28.   public
  29.     constructor Create(AOwner: TComponent); override;
  30.     destructor Destroy; override;
  31.     property Field: TField read GetField;
  32.   published
  33.     property DataField: String read GetDataField write SetDataField;
  34.     property DataSource: TDataSource read GetDataSource write SetDataSource;
  35.     property ReadOnly: Boolean read GetReadOnly write SetReadOnly;
  36.   end;
  37.  
  38. procedure Register;
  39.  
  40. implementation
  41.  
  42. uses
  43.   CommCtrl;
  44.  
  45. constructor TDBDateTimePicker.Create(AOwner: TComponent);
  46. begin
  47.   inherited;
  48.   FDataLink := TFieldDataLink.Create;
  49.   FDataLink.OnDataChange := DataChange;
  50.   FDataLink.OnUpdateData := UpdateData
  51. end;
  52.  
  53. destructor TDBDateTimePicker.Destroy;
  54. begin
  55.   FDataLink.Free;
  56.   FDataLink := nil;
  57.   inherited
  58. end;
  59.  
  60. procedure TDBDateTimePicker.SetDataSource(Value: TDataSource);
  61. begin
  62.   FDataLink.DataSource := Value;
  63.   if Value <> nil then
  64.     Value.FreeNotification(Self)
  65. end;
  66.  
  67. function TDBDateTimePicker.GetDataSource: TDataSource;
  68. begin
  69.   Result := FDataLink.DataSource
  70. end;
  71.  
  72. procedure TDBDateTimePicker.SetDataField(const Value: String);
  73. begin
  74.   FDataLink.FieldName := Value
  75. end;
  76.  
  77. function TDBDateTimePicker.GetDataField: String;
  78. begin
  79.   Result := FDataLink.FieldName
  80. end;
  81.  
  82. function TDBDateTimePicker.GetField: TField;
  83. begin
  84.   Result := FDataLink.Field
  85. end;
  86.  
  87. procedure TDBDateTimePicker.SetReadOnly(Value: Boolean);
  88. begin
  89.   FDataLink.ReadOnly := Value
  90. end;
  91.  
  92. function TDBDateTimePicker.GetReadOnly: Boolean;
  93. begin
  94.   Result := FDataLink.ReadOnly
  95. end;
  96.  
  97. procedure TDBDateTimePicker.DataChange(Sender: TObject);
  98. begin
  99.   if (Field = nil) or
  100.      (FDataLink.DataSet.State = dsInsert) then
  101.   case Kind of //If no data link is set up, show current date or time
  102.     dtkDate: Date := SysUtils.Date;
  103.     dtkTime: Time := SysUtils.Time
  104.   end
  105.   else
  106.   case Kind of //Update control if field changes
  107.     dtkDate: Date := FDataLink.Field.AsDateTime;
  108.     dtkTime: Time := FDataLink.Field.AsDateTime
  109.   end
  110. end;
  111.  
  112. procedure TDBDateTimePicker.UpdateData(Sender: TObject);
  113. begin
  114.   if Kind = dtkDate then //Update field as necessary
  115.     FDataLink.Field.AsDateTime := Date
  116.   else
  117.     FDataLink.Field.AsDateTime := Time
  118. end;
  119.  
  120. procedure TDBDateTimePicker.Notification(AComponent: TComponent;
  121.                                          Operation: TOperation);
  122. begin
  123.   inherited;
  124.   if (Operation = opRemove) and     //Blank out datasource value if
  125.      Assigned(FDataLink) and        //datasource is deleted from form
  126.      (AComponent = DataSource) then
  127.     DataSource := nil
  128. end;
  129.  
  130. procedure TDBDateTimePicker.CMEnter(var Msg: TCMEnter);
  131. begin
  132.   Invalidate; //Make sure calendar is up to date upon entry
  133.   inherited
  134. end;
  135.  
  136. procedure TDBDateTimePicker.CMExit(var Msg: TCMExit);
  137. begin
  138.   try //Update other data aware controls when user tabs away
  139.     FDataLink.UpdateRecord
  140.   except
  141.     SetFocus;
  142.     raise
  143.   end;
  144.   inherited
  145. end;
  146.  
  147. procedure TDBDateTimePicker.CNNotify(var Msg: TWMNotify);
  148. begin
  149.   case Msg.NMHdr^.Code of
  150.     dtn_CloseUp: //Update all other data aware controls
  151.       Perform(cm_Exit, 0, 0); //when calendar pops up
  152.     dtn_DateTimeChange: //Update field value when calendar changes
  153.     begin
  154.       FDataLink.Edit;
  155.       FDataLink.Modified;
  156.     end;
  157.   end;
  158.   inherited;
  159. end;
  160.  
  161. procedure Register;
  162. begin
  163.   RegisterComponents('Clinic', [TDBDateTimePicker]);
  164. end;
  165.  
  166. end.